home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / etch.zip / ETCH.FOR < prev   
Encoding:
Text File  |  1992-10-05  |  2.5 KB  |  142 lines
  1.     include 'graphapi.fi'
  2.  
  3.     program main
  4.     !===========
  5.  
  6.     include 'graph.fi'
  7.  
  8.     if( _setvideomode( _MAXRESMODE ) .eq. 0 )then
  9.         print *, 'No graphics adapter present'
  10.         stop
  11.     endif
  12.     if( InitMouse() .eq. 0 )then
  13.         print *, 'No mouse driver present'
  14.         stop
  15.     endif
  16.     call Etch()
  17.     call _setvideomode( _DEFAULTMODE )
  18.     end
  19.  
  20.  
  21.     subroutine Etch()
  22.     !================
  23.  
  24.     ! Follow the mouse and draw while the mouse button is pressed.
  25.     ! If 'Esc' is pressed, clear the screen. If 'End' is pressed, exit.
  26.  
  27.     include 'graph.fi'
  28.  
  29.     integer pen_down, ch
  30.     logical button
  31.     record /xycoord/ curr_pos, prev_pos
  32.     integer kbhit_, getch_
  33.  
  34.     call CursorOn()
  35.     pen_down = 0    ! pen is up
  36.  
  37.     loop
  38.         call GetPosition( curr_pos, button )
  39.         if( button )then     ! button pressed
  40.         if( pen_down .ne. 1 )then
  41.             pen_down = 1
  42.             call _moveto( curr_pos.xcoord, curr_pos.ycoord )
  43.             prev_pos = curr_pos
  44.         else
  45.             if( ( prev_pos.xcoord .ne. curr_pos.xcoord ) .or.
  46.      +                  ( prev_pos.ycoord .ne. curr_pos.ycoord ) )then
  47.             call CursorOff()
  48.             call _lineto( curr_pos.xcoord, curr_pos.ycoord )
  49.             call CursorOn()
  50.             prev_pos = curr_pos
  51.             endif
  52.         endif
  53.         else
  54.         pen_down = 0
  55.         endif
  56.         if( kbhit_() .ne. 0 )then
  57.         ch = getch_()
  58.         if( ch .eq. 0 )then
  59.             ch = 256 + getch_()
  60.         endif
  61.         if( ch .eq. 27 )then            ! ESC key
  62.             call CursorOff()
  63.             call _clearscreen( _GCLEARSCREEN )
  64.             call CursorOn()
  65.         else if( ch .eq. 335 )then      ! END key
  66.             return
  67.         endif
  68.         endif
  69.     endloop
  70.     end
  71.  
  72.  
  73. ! Mouse Library
  74.  
  75.  
  76.     integer function InitMouse()
  77.     !===========================
  78.  
  79.     include 'dos.fi'
  80.  
  81.     DS = ES = FS = GS = 0
  82.     AX = 0
  83.     call fintr( '33'x, regs )
  84.     InitMouse = AX
  85.     end
  86.  
  87.  
  88.     subroutine CursorOn()
  89.     !====================
  90.  
  91.     include 'dos.fi'
  92.  
  93.     DS = ES = FS = GS = 0
  94.     AX = 1
  95.     call fintr( '33'x, regs )
  96.     end
  97.  
  98.  
  99.     subroutine CursorOff()
  100.     !=====================
  101.  
  102.     include 'dos.fi'
  103.  
  104.     DS = ES = FS = GS = 0
  105.     AX = 2
  106.     call fintr( '33'x, regs )
  107.     end
  108.  
  109.  
  110.     subroutine GetPosition( pos, left )
  111.     !==================================
  112.  
  113.     include 'graph.fi'
  114.     include 'dos.fi'
  115.  
  116.     record /xycoord/ pos
  117.     logical left
  118.  
  119.     DS = ES = FS = GS = 0
  120.     AX = 3
  121.     call fintr( '33'x, regs )
  122.     pos.xcoord = CX
  123.     pos.ycoord = DX
  124.     left = BTEST( BX, 0 )
  125.     end
  126.  
  127.  
  128.     subroutine SetPosition( pos )
  129.     !============================
  130.  
  131.     include 'graph.fi'
  132.     include 'dos.fi'
  133.  
  134.     record /xycoord/ pos
  135.  
  136.     DS = ES = FS = GS = 0
  137.     AX = 4
  138.     CX = pos.xcoord
  139.     DX = pos.ycoord
  140.     call fintr( '33'x, regs )
  141.     end
  142.